home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / prog_d / wptools1.zip / DEMO / LABEL / UNIT1.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-13  |  2KB  |  73 lines
  1. unit Unit1;
  2.                
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Unit2, WPLabel, ExtCtrls;
  8.  
  9. type
  10.   TLabelForm = class(TForm)
  11.     Image1: TImage;
  12.     WPRichTextLabel1: TWPRichTextLabel;
  13.     procedure WPRichTextLabel1HyperLinkEvent(Sender: TObject; text,
  14.       stamp: String; LineNumber: Longint);
  15.     procedure FormPaint(Sender: TObject);
  16.   private
  17.     { Private-Deklarationen }
  18.   public
  19.     { Public-Deklarationen }
  20.   end;
  21.  
  22. var
  23.   LabelForm: TLabelForm;
  24.  
  25. implementation
  26.  
  27. {$R *.DFM}
  28.  
  29. procedure TLabelForm.WPRichTextLabel1HyperLinkEvent(Sender: TObject; text,
  30.   stamp: String; LineNumber: Longint);
  31. begin
  32.   if CompareText(text,'exit')=0 then close
  33.   else if CompareText(text,'edit')=0 then
  34.   begin
  35.     try
  36.       EditForm := TEditForm.Create(Self);
  37.       EditForm.WPRichText1.RtfText.Assign(WPRichTextLabel1.RtfText);
  38.       if EditForm.ShowModal=IDOK then
  39.       begin
  40.          WPRichTextLabel1.Visible := FALSE;
  41.          WPRichTextLabel1.RtfText.Assign(
  42.                    EditForm.WPRichText1.RtfText);
  43.          WPRichTextLabel1.Visible := TRUE;
  44.       end;
  45.     finally
  46.       EditForm.Free;
  47.     end;
  48.   end;
  49. end;
  50.  
  51. procedure TLabelForm.FormPaint(Sender: TObject);
  52. var i,a,b : Integer;
  53. begin
  54.   i := 0;
  55.   a := 0;
  56.   if Height>500 then b:=3
  57.   else if Height >250 then b:= 2
  58.   else b:= 1;
  59.   while i<Height do
  60.   begin
  61.      if a>254 then a:=0;
  62.      Canvas.Pen.Color :=
  63.          TColor(RGB(255-a,125-a div 2, a));
  64.      Canvas.MoveTo(0,i);
  65.      Canvas.LineTo(Width,i);
  66.      if (i mod b) = 0 then inc(a);
  67.      inc(i);
  68.   end;
  69.  
  70. end;
  71.  
  72. end.
  73.